home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / index.arc / AEBITCRQ.BAS < prev    next >
BASIC Source File  |  1987-01-12  |  1KB  |  47 lines
  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'Create an index (quiet)'
  4. rem $include:'aeshared.bas'
  5. '
  6. '  bit.creatq completed on 8-apr-1986. copy of bit.creat but with
  7. '  parameters passed in sub-routine invocation.
  8. '
  9. '  Modified 5-Jan-87 to open files for output on creation so that
  10. '  if files exist, they'll be truncated.
  11.  
  12. sub bit.creatq(fl%,flnm$,key.length%) static
  13.         idxk%=key.length%
  14.         hdr$=flnm$
  15.         aesb.warning%=1%
  16.         while idxk%>3% and idxk%<256%
  17.             while hdr$<>""
  18.                 mas$=hdr$+".idx"
  19.                 hdr$=hdr$+".hdr"
  20.                 recsize%=idxk%+2+2+2+2+2
  21.                 open "o",fl%,hdr$
  22.                 close fl%
  23.                 open "r",fl%,hdr$,512
  24.                 field #fl%,32 as desc$,32 as xmast$,2 as klen$,2 as nok$,2 as nexav$
  25.                 field #fl%,70 as twit$,2 as kdel$,440 as spare$
  26.                 lset desc$="(c) R.Barrow 1986,1987"+chr$(26)
  27.                 lset xmast$=mas$
  28.                 lset klen$=mki$(idxk%)
  29.                 lset nok$=mki$(0)
  30.                 lset nexav$=mki$(1)
  31.                 lset kdel$=mki$(0)
  32.                 put fl%,1%
  33.                 close fl%
  34.                 open "o",fl%,mas$
  35.                 close fl%
  36.                 open "r",fl%,mas$,recsize%
  37.                 field #fl%,recsize% as dummy$
  38.                 lset dummy$=string$(recsize%,0%)
  39.                 put #fl%,1%
  40.                 close fl%
  41.                 aesb.warning%=0%
  42.                 hdr$=""
  43.             wend
  44.             idxk%=0%
  45.         wend
  46.     end sub
  47.